;; $Id: mark.el,v 1.4 2005/05/27 13:53:37 greg Exp $

;; This file is not part of Emacs

;; Copyright (c) 2003 Greg Rowe

;; Author: Greg Rowe <emacs@therowes.net>
;; Maintainer: Greg Rowe <emacs@therowes.net>

;; COPYRIGHT NOTICE
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(defvar mark-ring-pos -1
  "This tracks the current position in the mark ring for movement.")
(make-variable-buffer-local 'mark-ring-pos)
(defadvice set-mark-command (after mark-reset-pos (arg))
  "After set-mark-command is called the mark-ring position will be
reset."
  (setq mark-ring-pos -1))
(ad-activate 'set-mark-command)

;; use addition to go backwards, and subtraction to go forward
(defun backward-mark (arg)
  "Moves the point arg points backward in the mark ring."
  (interactive "P")
  (if (null arg) (setq arg 1))
  (if (or mark-ring (mark t))
      (progn
        (let ((mark-ring-length (length mark-ring)))
          (setq mark-ring-pos (+ mark-ring-pos (abs arg)))
          (if (> mark-ring-pos mark-ring-length)
              (setq mark-ring-pos 
                    (- (- mark-ring-pos mark-ring-length ) 1)))
          (goto-nth-mark mark-ring-pos)))))

  
(defun forward-mark (arg)
  "Moves the point arg points forward in the mark ring."
  (interactive "P")
  (if (= -1 mark-ring-pos) (setq mark-ring-pos 0))
  (if (null arg) (setq arg 1))
  (if (or mark-ring (mark t))
      (progn
        (let ((mark-ring-length (length mark-ring)))
          (setq mark-ring-pos (- mark-ring-pos (abs arg)))
          (if (<  mark-ring-pos 0)
                (setq mark-ring-pos 
                    (+ (+ mark-ring-length mark-ring-pos) 1)))
          (goto-nth-mark mark-ring-pos)))))

(defun goto-nth-mark (arg)
  ;; Moves the point to the nth position in the mark ring (starts at 1).
  (let ( (the-place (cond
                     ((= arg 0) (mark t))
                     ((= arg 1) (car mark-ring))
                     (t (car (nthcdr (- arg 1) mark-ring))))))
    (if the-place
        (goto-char the-place))))




(defvar mark-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-m" 'mark-mode-goto)
    map)
  "Keymap for `mark-mode'.")


(defvar mark-buffer nil
  "Name of buffer for last show-marks.")


(put 'mark-mode 'mode-class 'special)

(define-derived-mode mark-mode nil "mark"
  "Major mode for output from \\[show-marks].
\\<mark-mode-map>Move point to one of the items in this buffer, then use
\\[mark-mode-goto] to go to the mark that the item refers to.
\\{mark-mode-map}"
  (make-local-variable 'mark-buffer))



(defun mark-mode-goto ()
  "Go to the occurrence the current line describes."
  (interactive)
  (let ((pos (get-text-property (point) 'marker)))
    (pop-to-buffer mark-buffer)
    (goto-char pos)))
    


(defun show-mark (mark-list)
  (if mark-list
      (let ((mymarker (car mark-list))
            (linenum 0)
            (mybol 0)
            (myeol 0)
            (prop-start 0))

        (save-current-buffer
          (set-buffer mark-buffer)
          (setq linenum (+ (count-lines 1 mymarker) 1))
          (save-excursion
            (goto-char  mymarker)
            (setq mybol (point-at-bol))
            (setq myeol (point-at-eol))))

        (setq prop-start (point))
        (insert (format "%6d: " linenum))
        (insert-buffer-substring mark-buffer mybol myeol)
        (insert "\n")
        (put-text-property prop-start (point) 'marker mymarker)
        (show-mark (cdr mark-list)))))


(defun show-marks ()
  "Displays all the lines for each point in the mark ring.  Pressing
RET in the result buffer will send you to corresponding mark point
with out affecting the mark-ring."
  (interactive)
  (with-output-to-temp-buffer "*marks*"
    (let ((old-buffer-mark-ring mark-ring))
      ;; prepend the current mark
      (setq old-buffer-mark-ring (cons (copy-marker (mark-marker)) mark-ring))
      (setq mark-buffer (current-buffer))
      (set-buffer standard-output)
      (show-mark old-buffer-mark-ring)
      (mark-mode))))




(provide 'mark)
